home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 027a / clipio.zip / BLAKSYST.PRG < prev    next >
Text File  |  1990-06-23  |  9KB  |  324 lines
  1. parameters choice
  2.  
  3. * begin
  4.     do case
  5.     case choice = 1
  6.         setcolors()
  7.     case choice = 2
  8.         blakpack()
  9.     case choice = 3
  10.         setmodem()
  11.     case choice = 4
  12.         setprint()
  13.     endcase
  14.     save all like _* to blakbook.mem
  15. return
  16.  
  17. *----------------------------------SETCOLORS-----------------------------------*
  18.  
  19. function setcolors
  20.  
  21. private choice, choices[19]
  22.  
  23. * begin
  24.     if !iscolor()
  25.         prompt(-1, -1, 'You monitor does not support colors.  Press any key to continue...', .t.)
  26.         return ''
  27.     endif
  28.     choices[1] = [Address enhanced]
  29.     choices[2] = [Address standard]
  30.     choices[3] = [Address unselected]
  31.     choices[4] = [Families enhanced]
  32.     choices[5] = [Families standard]
  33.     choices[6] = [Families unselected]
  34.     choices[7] = [Frame]
  35.     choices[8] = [Help Descriptions]
  36.     choices[9] = [Help Keys]
  37.     choices[10] = [Members enhanced]
  38.     choices[11] = [Members standard]
  39.     choices[12] = [Members unselected]
  40.     choices[13] = [Menus enhanced]
  41.     choices[14] = [Menus standard]
  42.     choices[15] = [Menus unselected]
  43.     choices[16] = [Notes]
  44.     choices[17] = [Prompts enhanced]
  45.     choices[18] = [Prompts standard]
  46.     choices[19] = [Prompts unselected]
  47.     vpushstate()
  48.     choice = 1
  49.     do while (choice > 0)
  50.         vsetcolor(_c_menu_st, _c_menu_en, _c_menu_un)
  51.         choice = menu(2, 35, 'Colors', choices, choice)
  52.         do case
  53.         case choice = 1
  54.             _c_addr_en = choose_color(_c_addr_en)
  55.         case choice = 2
  56.             _c_addr_st = choose_color(_c_addr_st)
  57.         case choice = 3
  58.             _c_addr_un = choose_color(_c_addr_un)
  59.         case choice = 4
  60.             _c_fami_en = choose_color(_c_fami_en)
  61.         case choice = 5
  62.             _c_fami_st = choose_color(_c_fami_st)
  63.         case choice = 6
  64.             _c_fami_un = choose_color(_c_fami_un)
  65.         case choice = 7
  66.             _c_fram = choose_color(_c_fram)
  67.         case choice = 8
  68.             _c_help = choose_color(_c_help)
  69.         case choice = 9
  70.             _c_hlpk = choose_color(_c_hlpk)
  71.         case choice = 10
  72.             _c_memb_en = choose_color(_c_memb_en)
  73.         case choice = 11
  74.             _c_memb_st = choose_color(_c_memb_st)
  75.         case choice = 12
  76.             _c_memb_un = choose_color(_c_memb_un)
  77.         case choice = 13
  78.             _c_menu_en = choose_color(_c_menu_en)
  79.         case choice = 14
  80.             _c_menu_st = choose_color(_c_menu_st)
  81.         case choice = 15
  82.             _c_menu_un = choose_color(_c_menu_un)
  83.         case choice = 16
  84.             _c_note = choose_color(_c_note)
  85.         case choice = 17
  86.             _c_wind_en = choose_color(_c_wind_en)
  87.         case choice = 18
  88.             _c_wind_st = choose_color(_c_wind_st)
  89.         case choice = 19
  90.             _c_wind_un = choose_color(_c_wind_un)
  91.         endcase
  92.         vpopscrn()
  93.         drawscreen()
  94.         dispmembers()
  95.         dispaddress()
  96.         dispnotes()
  97.     enddo
  98.     vpopstate()
  99. return ''
  100.  
  101. *--------------------------------CHOOSE_COLOR----------------------------------*
  102.  
  103. function choose_color
  104. parameters init_color
  105.  
  106. private ulr, ulc, row, col, rowcol, oldcursor, oldbutton, oldctrl
  107.  
  108. * begin
  109.     ulr = 2
  110.     ulc = 50
  111.     vpushstate()
  112.     mpushstate()
  113.     vpushscrn(ulr, ulc, ulr+16+1, ulc+16+1)
  114.  
  115.     *** draw selection screen
  116.     @ ulr, ulc to ulr+16+1, ulc+16+1
  117.     vfillattr(ulr, ulc, ulr+16+1, ulc+16+1, _c_wind_st)
  118.     ulr = ulr + 1
  119.     ulc = ulc + 1
  120.     oldctrl = msavectrl(ulr, ulc, ulr+15, ulc+15)
  121.     mdefctrl(ulr, ulc, ulr+15, ulc+15, 250)
  122.     for row = 0 to 15
  123.         rowcol = row * 16
  124.         for col = 0 to 15
  125.             vputstrc( ulr+row, ulc+col, chr(7), rowcol + col )
  126.         next col
  127.     next row
  128.  
  129.     row = int(init_color / 16)
  130.     col = init_color % 16
  131.  
  132.     old_row = 15
  133.     old_col = 15
  134.     lastkey = 0
  135.     do while ((lastkey <> 13) .and. (lastkey <> 27))
  136.         *** account for any movement on the screen
  137.         vputstrc(ulr+old_row, ulc+old_col, chr(7), old_row * 16 + old_col)
  138.         old_row = row
  139.         old_col = col
  140.         vputstrc(ulr+old_row, ulc+old_col, chr(15), old_row * 16 + old_col)
  141.  
  142.         *** get another keystroke and move cursor if necessary
  143.         lastkey = keyget()
  144.         do case
  145.         case (lastkey = -131) .and. (mgetbutton() == 'L ') .and. (mgetctrl() = 250)
  146.             row = mrow() - ulr
  147.             col = mcol() - ulc
  148.             keyinsert(13)
  149.         case (lastkey = -72)          && up arrow
  150.             row = (row + 15) % 16
  151.         case (lastkey = -80)          && down arrow
  152.             row = (row + 1) % 16
  153.         case (lastkey = -77)          && right arrow
  154.             col = (col + 1) % 16
  155.         case (lastkey = -75)          && left arrow
  156.             col = (col + 15) % 16
  157.         endcase
  158.     enddo
  159.     vpopscrn()
  160.     vpopstate()
  161.     mpopstate()
  162.     mrestctrl(ulr, ulc, ulr+15, ulc+15, oldctrl)
  163.     if lastkey = 13
  164.         return( row * 16 + col )
  165.     else
  166.         return( init_color )
  167.     endif
  168. * end
  169.  
  170. *----------------------------------BLAKPACK------------------------------------*
  171.  
  172. function blakpack
  173.  
  174. * begin
  175.     prompt(12, -1, 'Removing deleted records and reindexing.  Please wait...', .f.)
  176.     select MEMBERS
  177.     set filter to
  178.     set index to
  179.     pack
  180.     index on UNIQUE + upper(NAME) to MEMBUNIQ
  181.     index on right(dtos(BIRTHDAY), 4) to MEMBBIRT
  182.     index on right(dtos(ANNIVERS), 4) to MEMBANNI
  183.     select FAMILIES
  184.     set filter to
  185.     set index to
  186.     pack
  187.     index on upper(NAME) + PHONE to FAMINAME
  188.     index on UNIQUE to FAMIUNIQ
  189.     select MEMBERS
  190.     set index to MEMBUNIQ, MEMBBIRT, MEMBANNI
  191.     set filter to (!deleted())
  192.     select FAMILIES
  193.     set index to FAMINAME, FAMIUNIQ
  194.     set filter to (!deleted())
  195.     go top
  196.     lastrecno = 0
  197.     vpopscrn()
  198. return ''
  199.  
  200. *----------------------------------SETMODEM------------------------------------*
  201.  
  202. function setmodem
  203.  
  204. private choice, choices[6], vars[6], lens[6]
  205.  
  206. choices[1] = 'Area code:   '
  207. choices[2] = 'Local prefix:'
  208. choices[3] = 'Local suffix:'
  209. choices[4] = 'Long prefix: '
  210. choices[5] = 'Long suffix: '
  211. choices[6] = 'Port:        '
  212.  
  213. vars[1] = [_areacode]
  214. vars[2] = [_localpre]
  215. vars[3] = [_localsuf]
  216. vars[4] = [_longpre]
  217. vars[5] = [_longsuf]
  218. vars[6] = [_comport]
  219.  
  220. lens[1] = 3
  221. lens[2] = 10
  222. lens[3] = 10
  223. lens[4] = 10
  224. lens[5] = 10
  225. lens[6] = 4
  226.  
  227. * begin
  228.     vpushstate()
  229.     choice = 1
  230.     do while (choice > 0)
  231.         for lcv = 1 to 6
  232.             variable = vars[lcv]
  233.             choices[lcv] = left(choices[lcv], 13) + trim(&variable)
  234.         next lcv
  235.         vsetcolor(_c_menu_st, _c_menu_en, _c_menu_un)
  236.         choice = menu(2, 35, 'Printer Codes', choices, choice)
  237.         if choice > 0
  238.             variable = vars[choice]
  239.             &variable = pad(&variable, lens[choice])
  240.             vsetcolor(_c_wind_st, _c_wind_en, _c_wind_un)
  241.             prompt(10, -1, 'Enter ' + trim(left(choices[choice], 13)) + ': ' + space(lens[choice]), .f.)
  242.             @ row(), col() - lens[choice] get &variable
  243.             vsetcursor(.t.)
  244.             read
  245.             vsetcursor(.f.)
  246.             vpopscrn()
  247.             vsetcolor(_c_menu_st, _c_menu_en, _c_menu_un)
  248.         endif
  249.         vpopscrn()
  250.     enddo
  251.     vpopstate()
  252. return ''
  253.  
  254. *----------------------------------SETPRINT------------------------------------*
  255.  
  256. function setprint
  257.  
  258. private choice, choices[5], oldcolor, vars[5], lcv, ptr, variable
  259.  
  260. vars[1] = '_boldon'
  261. vars[2] = '_boldoff'
  262. vars[3] = '_17cpi'
  263. vars[4] = '_12cpi'
  264. vars[5] = '_10cpi'
  265.  
  266. choices[1] = [Bold on:   ]
  267. choices[2] = [Bold off:  ]
  268. choices[3] = [Compressed:]
  269. choices[4] = [Elite:     ]
  270. choices[5] = [Pica:      ]
  271.  
  272. * begin
  273.     vpushstate()
  274.     choice = 1
  275.     do while (choice > 0)
  276.         for lcv = 1 to 5
  277.             choices[lcv] = left(choices[lcv], 11)
  278.             variable = vars[lcv]
  279.             variable = &variable
  280.             for ptr = 1 to 5
  281.                 choices[lcv] = choices[lcv] + ltrim(str(asc(substr(variable, ptr, 1)), 3, 0)) + ', '
  282.             next ptr
  283.             choices[lcv] = left(choices[lcv], len(choices[lcv]) - 2)
  284.         next lcv
  285.         vsetcolor(_c_menu_st, _c_menu_en, _c_menu_un)
  286.         choice = menu(2, 50, 'Printer Codes', choices, choice)
  287.         if choice > 0
  288.             variable = vars[choice]
  289.             &variable = getpcode(&variable)
  290.         endif
  291.         vpopscrn()
  292.     enddo
  293.     vpopstate()
  294. return ''
  295.  
  296. *----------------------------------GETPCODE------------------------------------*
  297.  
  298. function getpcode
  299. parameters code
  300.  
  301. private lcv, ns[5], initcol
  302.  
  303. * begin
  304.     afill(ns, 0)
  305.     for lcv = 1 to len(code)
  306.         ns[lcv] = asc(substr(code, lcv, 1))
  307.     next lcv
  308.     vsetcolor(_c_wind_st, _c_wind_en, _c_wind_un)
  309.     prompt(10, -1, 'Enter ' + trim(left(choices[choice], 11)) + ' codes in decimal:                    ', .f.)
  310.     initcol = col() - 24
  311.     for lcv = 1 to 5
  312.         @ row(), (lcv * 4) + initcol get ns[lcv] picture '###'
  313.     next lcv
  314.     vsetcursor(.t.)
  315.     read
  316.     vsetcursor(.f.)
  317.     vpopscrn()
  318.     vsetcolor(_c_menu_st, _c_menu_en, _c_menu_un)
  319.     code = ''
  320.     for lcv = 1 to 5
  321.         code = code + chr(ns[lcv])
  322.     next lcv
  323. return code
  324.